home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
rdkybd.zip
/
RDKYBDEM.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
8KB
|
289 lines
program Rdkybdem; {demo for Turbo Pascal 4.0 Rdkybd unit}
{John Haluska, CIS 74000,1106}
uses Crt,Rdkybd;
var
Select : char;
procedure ErrorToneTest;
var
Ch : char;
X,Y : byte;
begin
Writeln(#13,#10,'A: procedure ErrorTone;');
Writeln(' Enter character: 1 : Generate ErrorTone (if enabled)');
Writeln(' 2 : Enable ErrorTone');
Writeln(' 3 : Disable ErrorTone');
Writeln(' ESC : Exit this test',#13,#10);
X := WhereX; Y := WhereY;
repeat
Ch := ReadKey;
GotoXY(X,Y);
case Ch of
'1' : begin
Write('1: Generate ErrorTone (if enabled) ');
ErrorTone;
end;
'2' : begin
Write('2: Enable ErrorTone ');
ErrorToneEnb := True;
end;
'3' : begin
Write('3: Disable ErrorTone ');
ErrorToneEnb := False;
end;
#27 : ; {Esc}
#0 : begin {Extended key}
Write('Invalid key ');
Ch := ReadKey;
end;
else Write('Invalid key ');
end;
until Ch = #27; {Esc}
Writeln;
end;
procedure PasswordTest;
var
S : string;
begin
Writeln('B: procedure Password : string;');
Write(' Enter password: ');
Password(S);
Writeln;
Writeln(' The Password entered is: ',S);
end;
procedure ReadByteTest;
var
N : byte;
Ch : char;
X,Y : byte;
begin
Writeln('C: procedure ReadByte : byte; Only valid bytes accepted.');
Writeln(' Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
Writeln;
repeat
X := WhereX; Y := WhereY;
Write(' Enter number: ');
ReadByte(N);
GotoXY(X+35,Y);
Writeln('Press ESC to quit, any other key to repeat.');
Ch := ReadKey;
until Ch = #27;
end;
procedure ReadIntgrTest;
var
N : integer;
Ch : char;
X,Y : byte;
begin
Writeln('D: procedure ReadIntgr : integer; Only valid integers accepted.');
Writeln(' Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
Writeln;
repeat
X := WhereX; Y := WhereY;
Write(' Enter number: ');
ReadIntgr(N);
GotoXY(X+35,Y);
Writeln('Press ESC to quit, any other key to repeat.');
Ch := ReadKey;
until Ch = #27;
end;
procedure ReadLongIntTest;
var
N : longint;
Ch : char;
X,Y : byte;
begin
Writeln('E: procedure ReadLongInt : longint;');
Writeln(' Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
Writeln;
repeat
X := WhereX; Y := WhereY;
Write(' Enter number: ');
ReadLongInt(N);
GotoXY(X+35,Y);
Writeln('Press ESC to quit, any other key to repeat.');
Ch := ReadKey;
until Ch = #27;
end;
procedure ReadByteMinMaxTest;
var
P,Q,N,Temp : byte;
Ch : char;
begin
Writeln('F: procedure ReadByteMinMax(Min,Max : byte) : byte;');
Writeln(' Only valid bytes in range min to max accepted.');
Writeln(' Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
Writeln;
repeat
Write(' Enter min byte: ');
ReadByte(P);
Write(' ');
Write(' Enter max byte: ');
ReadByte(Q);
Write (#10,#13,' Enter sample byte: ');
ReadByteMinMax(P,Q,N);
Writeln(#10,#13,' Press ESC to quit, any other key to repeat.');
Ch := ReadKey;
Writeln;
until Ch = #27;
end;
procedure ReadIntgrMinMaxTest;
var
P,Q,N : integer;
Ch : char;
begin
Writeln('G: procedure ReadIntgrMinMax(Min,Max : integer) : integer;');
Writeln(' Only valid integers in range min to max accepted.');
Writeln(' Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
Writeln;
repeat
Write(' Enter min integer: ');
ReadIntgr(P);
Write(' ');
Write(' Enter max integer: ');
ReadIntgr(Q);
Write (#10,#13,' Enter sample integer: ');
ReadIntgrMinMax(P,Q,N);
Writeln(#10,#13,' Press ESC to quit, any other key to repeat.');
Ch := ReadKey;
Writeln;
until Ch = #27;
end;
procedure ReadLongIntMinMaxTest;
var
P,Q,N : longint;
Ch : char;
begin
Writeln('H: procedure ReadLongIntMinMax(Min,Max : longint) : longint;');
Writeln(' Only valid longintegers in range min to max accepted.');
Writeln(' Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
Writeln;
repeat
Write(' Enter min longinteger: ');
ReadLongInt(P);
Write(' ');
Write(' Enter max longinteger: ');
ReadLongInt(Q);
Write (#10,#13,' Enter longinteger: ');
ReadLongIntMinMax(P,Q,N);
Writeln(#10,#13,' Press ESC to quit, any other key to repeat.');
Ch := ReadKey;
Writeln;
until Ch = #27;
end;
procedure ReadRealTest;
var
R : real;
Ch : char;
begin
Writeln('I: procedure RealReal : real; Only valid real numbers accepted');
Writeln(' Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
Writeln;
repeat
Write(' Enter any number: ');
ReadReal(R);
Writeln;
Writeln('Press ESC to quit, any other key to repeat.');
Ch := ReadKey;
Writeln;
until Ch = #27;
end;
procedure ReadRealMinMaxTest;
var
X,Y,Z : real;
Ch : char;
begin
Writeln('J: procedure ReadRealMinMax(Min,Max : real) : real; ');
Writeln(' Only valid reals in range min to max accepted.');
Writeln(' Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
Writeln;
repeat
Write(' Enter min real: ');
ReadReal(X);
Writeln;
Write(' Enter max real: ');
ReadReal(Y);
Write (#10,#13,' Enter sample real: ');
ReadRealMinMax(X,Y,Z);
Writeln(#10,#13,' Press ESC to quit, any other key to repeat.');
Ch := ReadKey;
Writeln;
until Ch = #27;
Writeln;
end;
procedure ReadStringTest;
var
S : string;
Ch : char;
begin
Writeln('K: procedure ReadString : string;');
Writeln(' Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
Writeln;
repeat
Write(' Enter string: ');
ReadString(S);
Writeln(#13,#10,' Press ESC to quit, any other key to repeat.');
Ch := ReadKey;
until Ch = #27;
end;
begin
ClrScr;
repeat
Writeln;
Write ('Enter: (M) Menu, (Q) Quit, or Test Selection Letter: ');
Select := ReadKey;
if Select <> #0 then
begin
Select := UpCase(Select);
Writeln (Select);
end
else Select := Readkey;
Writeln;
case Select of
'M' : begin
ClrScr;
Writeln(' Turbo Pascal 4.0 Rdkybd Unit Demo');
Writeln;
Writeln(' A ErrorTone');
Writeln(' B Password');
Writeln(' C ReadByte');
Writeln(' D ReadIntgr');
Writeln(' E ReadLongInt');
Writeln(' F ReadByteMinMax');
Writeln(' G ReadIntgrMinMax');
Writeln(' H ReadLongIntMinMax');
Writeln(' I ReadReal');
Writeln(' J ReadRealMinMax');
Writeln(' K ReadString');
end;
'A' : ErrorToneTest;
'B' : PasswordTest;
'C' : ReadByteTest;
'D' : ReadIntgrTest;
'E' : ReadLongIntTest;
'F' : ReadByteMinMaxTest;
'G' : ReadIntgrMinMaxTest;
'H' : ReadLongIntMinMaxTest;
'I' : ReadRealTest;
'J' : ReadRealMinMaxTest;
'K' : ReadStringTest;
'Q' : ;
end;
until Select = 'Q';
end.